home *** CD-ROM | disk | FTP | other *** search
/ Oh!X 2001 Spring / Oh!X 2001 Spring Special CD-ROM (Japan) (Track 1).bin / CGI / list1.cgi next >
Encoding:
Text File  |  2000-10-28  |  1.8 KB  |  93 lines
  1. #!/usr/local/bin/perl
  2.  
  3. require "cgi-lib.pl";
  4.  
  5. #---------------------------------------
  6. #REFERER LOGGER - その1(CGI版)
  7. #        by de. 2000
  8. #---------------------------------------
  9.  
  10. my $referer; #REFERER文字列が入る変数
  11. my @queue;#URL20個の配列
  12. my $myself="http://web.pe.to/~deyamato"; #省くアドレス
  13. my $logfilename="refererlog.dat";
  14.  
  15. #画像を表示
  16. open(GIF,"./banner.gif");
  17. @gifdata = stat("./banner.gif");
  18. $byte = $gifdata[7];
  19. print "Content-type: image/gif\n";
  20. print "Content-length: $byte\n\n";
  21. print <GIF>;
  22. close(GIF);
  23.  
  24. #QUERY文字列からハッシュを作る
  25. &ReadParse(*input);
  26. @val = split(/&/,$input);
  27. foreach $i(0 .. $#val){
  28.     $val[$i] =~ s/%(..)/pack("c",hex($1))/ge;
  29.     ($name,$value) = split(/=/,$val[$i],2);
  30.     $value =~ s/\+/ /g;
  31.     $val{$name} = $value;
  32. }
  33.  
  34. if($ENV{HTTP_REFERER} ne ""){
  35.     $referer = $ENV{HTTP_REFERER};
  36. }
  37.  
  38. if($referer =~ /^http:\/\//){
  39.     if(!($referer =~ /$myself/)){
  40.     Getlogfile($referer);
  41.     }
  42. }
  43.  
  44. #終わり処理
  45. close(ERRLOG);
  46. exit(0);
  47.  
  48. sub Getlogfile{
  49.  
  50.     ($current_url)=@_; #現在のアクセス元URL
  51.     my $last_url; #過去の中で最新のURL
  52.     
  53.     my $date,count;
  54.     my $count=0;
  55.  
  56.     open(LOG,$logfilename)|| print ERRLOG "LOGFILE READ ERROR\n";
  57.     while(<LOG>){
  58.         chop;
  59.         &put_queue($_);
  60.         $last_url=$_;
  61.     }
  62.     close LOG;
  63.  
  64.     #--ログのURLをチェック
  65.     if($current_url ne $last_url){
  66.         &put_queue($current_url);
  67.     }
  68.  
  69.     #-- ログファイルにかき出す
  70.     open(LOG,">$logfilename")|| print ERRLOG "LOGFILE WRITE ERROR\n";
  71.     for($i=20;$i>=0;--$i){
  72.         if($queue[$i] ne ""){
  73.             #もし、重複するURLは記録しないならコメントをはずす
  74.             #if($queue[$i] ne $current_url){
  75.                 print LOG "$queue[$i]\n";
  76.             #} 
  77.         }
  78.     }
  79.     close(LOG);
  80.  
  81. }
  82.  
  83. sub put_queue{
  84.     #print " ** put_queue!! **\n";
  85.     for($i=20;$i>0;$i=$i-1){
  86.         $j=$i-1;
  87.         #print "queue$j($queue[$j]) => queue$i($queue[$i])\n";    
  88.         $queue[$i]=$queue[$i-1];
  89.     }    
  90.     $queue[0]=$_[0];
  91.  
  92. }
  93.